home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / ghdr.vbs < prev    next >
Encoding:
Text File  |  1992-02-07  |  34.1 KB  |  1,000 lines

  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. /*
  11.  * 14-aug-85        shields
  12.  * add type_kind field. This will hold one of the TK_ type kind values.
  13.  * type_size will now always be in storage units, except for initial value
  14.  * -1 indicating undefined.
  15.  * The (new) procedure kind_size maps TK_ values to storage units.
  16.  *
  17.  * 25-jul-85        shields
  18.  * add structure def for Gref and Gref_s for use by print_global_reference_map.
  19.  *
  20.  * 8-jul-85        shields
  21.  * Note that code generator defines SIGNATURE of package to be a tuple
  22.  * of symbols. This is incomptatible with adasem usage. Instead we
  23.  * now define the third entry in the MISC value for a package, which is
  24.  * a tuple, to be the tuple formerly held in the SIGNATURE.
  25.  *
  26.  * 31-may-85        shields
  27.  * modify co_ codes to agree with values defined by adasem.
  28.  *
  29.  * 22-mar-85        shields
  30.  * renamed discriminant_list to discriminant_list_get to avoid
  31.  * confusion with SEM macro of same name.
  32.  */
  33.  
  34. /*                Introduction         
  35.  *
  36.  * This section describes the main issues and data structures that
  37.  * arise in translating the SETL version of the  Ada/Ed code generator
  38.  * from SETL to C.  It augments the documentation available in the
  39.  * preliminary draft of the Kruchten-Rosen thesis describing the
  40.  * design of Ada machine.
  41.  *
  42.  * The SETL version does not
  43.  * clearly present a solution for the addressing problems for a
  44.  * conventional byte-addressable machine; the addressing issues are
  45.  * avoided by using an abstract approach in which memory and related
  46.  * structures are organized as SETL tuples, whose components can
  47.  * have varying length. Much of the work in translating to C involves
  48.  * identifying the tuple operations that require mapping to byte strings
  49.  * and computing the appropriate offsets, etc.
  50.  * 
  51.  * The initial C version has a storage unit size corresponding to a 'word
  52.  * (C integer). 
  53.  */
  54.  
  55.  
  56. /*                
  57.     TYPE_SIZE, mem_loc_map, and related procedures
  58.  
  59.  In SETL, the TYPE_SIZE field is used both to hold a type 'kind' and
  60.  the number of storage units associated with a type. In the C version
  61.  there are two symbol table fields - type_kind and type_size.
  62.  Type_kind is the 'kind' one of the TK_ codes defined below.
  63.  Type_size is the number of storage units, except for the value -1
  64.  used to indicate the size not yet known. The procedure su_size()
  65.  takes TK_ codes to the correspond storage unit count.
  66.  */
  67. #define TK_BYTE 1
  68. #define TK_WORD 2
  69. #define TK_ADDR 3
  70. #define TK_LONG 4
  71. #define TK_DBLE 5
  72. #define TK_XLNG 6
  73. /*
  74.  The SETL macro SIZE_OF just corresponds to TYPE_SIZE.
  75.  Note that TYPE_SIZE is in some cases set to -1 so it must be treated
  76.  as a signed number.
  77.  TYPE_SIZE is also used in the SETL version for holding the array size
  78.  and for record component offsets ('POSITION) values. For the C version
  79.  the procedure su_size is used to convert the TK_ type to the number
  80.  of storage units required.
  81.  
  82.  The mu_... codes identify the kinds of memory units.. The procedure
  83.  mu_size(mu...) gives the number of actual storage units 
  84.  needed for the given mu class. In SETL the variable mem_loc_map is
  85.  used to determine the number of bytes. It is
  86.  not needed in the C version, where mu_size is a
  87.  procedure. Note that mu_size is called only within file gmisc and there
  88.  to compute stack and varaiable offsets.
  89.  The procedure kind_of(type_name) returns the memory unit addressing
  90.  mode for the argument type_name; the return value is one of the
  91.  mu_ codes. The kind_of value is used in the generate() procedures
  92.  (see below) to determine the 'kind' of an operation, a small integer
  93.  code to select which of several variants of a base operation is to
  94.  be performed.
  95.  
  96.     Representation of fixed-point values (TBSL)
  97.     Program parameters (TBSL)
  98.  */
  99.  
  100. /*                 Segments 
  101.  
  102. The memory of the target ada pseudo-machine is organized into segments.
  103. In SETL, a segment is a tuple of 'words',  where it is understood that the
  104. contents of the tuples are to be concatened together to represent the
  105. true memory image. In C a segment is represented by a structure which
  106. maintains a varying length array. The data can consist of bytes or
  107. words (unsigned integers). The fields of the structure are as follows:
  108. Seg_kind is the kind of the segment - SEGMENT_KIND_CODE for a code segment
  109. and SEGMENT_KIND_DATA for a data segment. Seg_size is the number of
  110. bytes in a segment entry: one for a code segment, or sizeof(int) for a
  111. data segment. Seg_pos is the index at which the next value will be placed.
  112. seg_maxpos is the largest value attained by seg_pos, so that the actual
  113. segment data consists of entries in range 0 .. seg_maxpos - 1.
  114. Seg_dim is the allocated dimension of the data area.
  115. Seg_extend is the number of new entries to allocate when the segment
  116. becomes full.
  117. The segment must be extended whenever seg_pos >= seg_dim.
  118. The header file segment.h has declarations for segments.
  119.  */
  120.  
  121. #define MAIN_CS 2    /* code segment number for main code segment */
  122. /* 
  123.  
  124. The variables CODE_SEGMENT and DATA_SEGMENT indicate the current
  125. segments being used for code and data, respectively.  The operations on
  126. segments are represented in C by following procedures:  
  127.     segment_append(sa, sb) Segment sa,sb;
  128.         append contents of segment sb at end of segment sa
  129.         (currently defined only for word segments)
  130.      segment_new(kind, n) int kind,n;
  131.          allocate new segment of kind kind, 
  132.         with initial room for n entries
  133.     segment_free(s) Segment s;
  134.         free segment s;
  135.     segment_get_off(seg, i) Segment seg; int i;
  136.         return seg value at position i in segment seg as unsigned int.
  137.     segment_get_word(seg, i) Segment seg; int i;
  138.         synonym for segment_get_off.
  139.     segment_put_off(seg,v) Segment seg; int i,v
  140.         put value of offset v at location i (seg_i not updated)
  141.     segment_put_int(seg,v) Segment seg,int v;
  142.         put value of v at current position in segment seg.
  143.     segment_put_long(seg, lv) Segment seg; long lv;
  144.         put value of lv at current position in segment seg.
  145.     segment_put_ref(seg, rseg, roff) Segment seg; ing rseg,roff;
  146.         put values of rseg and roff at current position in segment seg.
  147.     segment_put_word(seg,v) Segment seg,int v;
  148.         put value of v at current position in segment seg.
  149.         (identical to segment_put_int)
  150.  
  151. Segments are also used when building up varying length strings before
  152. their inclusion in the final code and data segments; for example, while
  153. computing the string corresponding to the initial value of an aggregate.
  154.  */
  155.  
  156. /*            References
  157.  
  158. A memory address or 'reference' on the Ada machine consists of a
  159. segment and an offset.  The offset is an unsigned integer, zero origin,
  160. of 16 bits.  In the SETL version, a 'reference' is a pair
  161. [segment,offset].  Rather than introducing a structure for this in C, we
  162. use two integers.  The case of an 'undefined' reference is indicated by
  163. using a negative segment number, typically -1.  For the PC, we want to
  164. view the offset as an unsigned int.  The SETL map REFERENCE_MAP becomes
  165. two symbol table fields:  S_SEGMENT and S_OFFSET.  The SETL map
  166. LOCAL_REFERENCE_MAP is represented in C with a procedural interface:  
  167.     local_reference_map_defined(sym)
  168.         returns TRUE if map defined for symbol sym, else FALSE
  169.     local_reference_map_put(sym,val);
  170.     local_reference_map_get(sym);
  171.     local_reference_map_new(n)
  172. These procedures access the global variable LOCAL_REFERENCE_MAP, which
  173. is a tuple with successive pairs of elements giving the symbol and
  174. offset values.
  175.  
  176. In SETL, the procedure next_global_reference has the form
  177.     next_global_reference(sym,val)
  178. where sym is a symbol and val is a value, usually a tuple.  This should
  179. be read 'set the address of sym to be the next free address in the
  180. current data segment and intialize it to the value val'.  In SETL, val is
  181. typically a tuple.  However, in C we need to know the `type' of val, so
  182. we use the procedures 
  183.     next_global_reference_r(sym,seg,off)
  184.         seg is segment, off is offset
  185.     next_global_reference_segment(sy, seg)
  186.         sy is symbol, seg is Segment.
  187.     next_global_reference_template(sy, seg)
  188.         same as next_global_reference_segment.
  189.     next_global_reference_def(sym)
  190.         just reference, no value, same as SETL
  191.         next_global_reference(sym,[]);
  192.       next_global_reference_z(sym)
  193.         this is used for SETL case next_global_reference(sym,[0,0]);
  194.         This appears to be a common case, indicating that the initial
  195.         value is set to 'zero' for sake of completeness, but
  196.         will be overwritten at execution time by the address
  197.         of a generated location.
  198.     next_global_reference_word(sym, n)
  199.         sym is symbol, n is word (integer).
  200.  
  201.  
  202. In SETL, reference_of is a procedure that returns a pair giving a 
  203. segment and offset.
  204. In C, this procedure sets two globals, REFERENCE_SEGMENT and REFERENCE_OFFSET.
  205. */
  206.  
  207. /*            Slots
  208.  
  209. Slots are used for segments and exceptions.  A code slot is a code
  210. segment number, a data slot is a data segment number, and an exception
  211. slot is the exception number assigned to an exception.  A slot is
  212. allocated when spec encountered; for a package, the slot is 
  213. 'owned' by the package spec.
  214. A slot number is an integer in range 1..255.  In SETL slots are
  215. maintained by maps OWNED_SLOTS and BORROWED_SLOTS.  OWNED_SLOTS for a
  216. unit has three entries 
  217.     1    for 'data_slots'
  218.     2    for 'code_slots'
  219.     3    for 'exception_slots'
  220. BORROWED_SLOTS for a unit has two entries:
  221.     1    for 'data_borrowed'
  222.     2    for 'code_borrowed'
  223. In C, these are accessed through the procedures
  224.     unit_slots_put(unit_number,tup)
  225.     Tuple unit_slots_get(unit_number)
  226. The second argument to unit_slots_put and the value returned by unit_slots_get
  227. are a tuple of length five, as follows:
  228.     1    for 'data_slots'       SLOTS_DATA
  229.     2    for 'code_slots'    SLOTS_CODE
  230.     3    for 'exception_slots'    SLOTS_EXCEPTION
  231.     4    for 'data_borrowed'    SLOTS_DATA_BORROWED
  232.     5    for 'code_borrowed'    SLOTS_CODE_BORROWED
  233. The variables OWNED_SLOTS and BORROWED_SLOTS in the SETL version do not
  234. exist in the C version; instead OWNED_SLOTS corresponds to the first three
  235. components of the tuple returned by unit_slots_get(), and BORROWED_SLOTS
  236. corresponds to the remaining two components of this tuple.
  237.  
  238. CODE_SLOTS, DATA_SLOTS and EXCEPTION_SLOTS are maps that have symbols as
  239. their domain.  They are represented in C by tuples with successive pairs
  240. of values giving the domain and range values.  Note that CODE_SLOTS and
  241. DATA_SLOTS occur in SETL source primarily as first arguments to
  242. select_entry.  A 'slot_map_name' is a unit_name.  These are represented
  243. in C as 'tuple maps', a tuple with successive pairs of elements giving
  244. the domain and range values.  The domain values are slot_map_names.  The
  245. range values are tuples.  
  246.  
  247. OWNED_SLOTS and BORROWED_SLOTS are not variables in the C version; their
  248. values can be obtained from the first three or last two components of the
  249. tuple returned by unit_slots_get().
  250. INIT_SLOTS and MAX_INDEX are procedures init_slots() and max_index() in
  251. the C version.  
  252.  
  253. Types used for select_entry:
  254.  */
  255. #define SLOTS_DATA 1
  256. #define SLOTS_CODE 2
  257. #define SLOTS_EXCEPTION 3
  258. #define SLOTS_DATA_BORROWED 4
  259. #define SLOTS_CODE_BORROWED 5
  260.  
  261. /* 
  262. These correspond to tags 'data_slots', 'code_slots', 'exception_slots',
  263. 'data_borrowed' and 'code_borrowed', respectively, used as third argument
  264. to select_entry.
  265.  
  266. The first argument to select_entry is either CODE_SLOTS or DATA_SLOTS
  267. in SETL. In C this is represented by one fo the following constants:
  268.  */
  269. #define SELECT_CODE 0
  270. #define SELECT_DATA 1
  271. #define SELECT_EXCEPTIONS 2
  272.  
  273. /* OWNED_SLOTS is map from slot_map_names showing the slots allocated to
  274. a unit.  BORROWED_SLOTS is similar, but gives slots used by a unit but
  275. owned by another unit.  INIT_SLOTS is map from slot_map_names to highest
  276. occupied number.  MAX_INDEX is map from slot_map_names to max allowed
  277. slot number.  MAX_INDEX is a procedure in C version.
  278. CURRENT_CODE_SEGMENT and CURRENT_DATA_SEGMENT are the current segment
  279. numbers for the code and data segment, respectively.  CODE_SEGMENT_MAP
  280. and DATA_SEGMENT_MAP are maps from segment numbers to the corresponding
  281. segments.  In C these are kept as tuples and accessed using the
  282. following procedures:  
  283.     tup = segment_map_new(n)
  284.     seg = segment_map_get(tup,segnum)
  285.     tup = segment_map_put(tup,segnum,seg)
  286. where n is integer, tup is CODE_SEGMENT_MAP or DATA_SEGMENT_MAP, segnum
  287. is integer giving segment number and seq is segment.
  288. Note that call to segment_map_put must assign the result to a variable as the
  289. variable value may be changed by reallocating the value if a new entry is being
  290. added.
  291.  */
  292.  
  293.  
  294. /*            Instruction generation
  295.  
  296. The operand of an operation is one of following
  297.     Symbol
  298.     Immediate value
  299. A symbol is used for global or local reference, the address is obtained
  300. from the symbol.  An immediate value is either byte word long or xlong.
  301. For an exception it is a byte.  The length of the immediate value is
  302. determined from the opcode.  There are psudeo-ops.  Notable is i_equal
  303. which has two operands, both symbols.  
  304.  
  305. In SETL, the procedure generate is used to generate an instruction.  It
  306. is called with a varying number of arguments of differing types.  In C,
  307. each call to generate is translated to a procedure call giving the types
  308. and number of its arguments.  
  309.     generate(op)    ->    gen(op)
  310. Otherwise, the procedure name is gen_ followed by one letter for each
  311. argument after the first (which is always an integer opcode).  The
  312. suffixes are as follows:  
  313.      i    integer
  314.      s    symbol    
  315.      c    comment (argument is string)
  316.      v    ivalue
  317. Sample procedure used, include gen_i, gen_s, gen_ic, etc.  In cases
  318. where SETL uses pair as single argument to procedure, the C version will
  319. use two arguments.  For generator routines, this will be indicated by
  320. argument type of rr, indicating two arguments actually passed, the first
  321. a segment, the second an offset.  
  322.  
  323.  */
  324. /* The following constants define the data and addressing modes used
  325.  * in generating instructions.
  326.  */
  327. #define D_NONE    0
  328. #define D_ALL    1
  329. #define D_INT    2
  330. #define    D_FIX    3
  331. #define D_FLOAT 4
  332. #define D_PSEUDO 5
  333.  
  334. #define A_NONE    0
  335. #define A_BOTH    1
  336. #define    A_LOCAL    2
  337. #define A_GLOBAL 3
  338. #define A_CODE    4
  339. #define    A_PREDEF 5
  340. #define A_EXCEPTION 6
  341. #define A_IMM    7
  342. #define A_ATTR    8
  343. #define A_PSEUDO 9
  344.  
  345. /* An Explicit_ref is used to main an explicit reference (segment and
  346.  * offset).
  347.  */
  348. typedef struct Explicit_ref_s {
  349.     short    explicit_ref_seg;
  350.     short    explicit_ref_off;
  351. } Explicit_ref_s;
  352. typedef struct Explicit_ref_s *Explicit_ref;
  353.  
  354. /*             Relay sets 
  355.  
  356. In SETL a relay set is a set of symbols.  In C, we keep it as a tuple of
  357. symbols, always checking for membership before adding a new symbol.  
  358.  */
  359.  
  360. /*            Patches
  361.  
  362. To handle forward references, several 'patch' sets are maintained.
  363. SUBPROG_PATCH is kept as a 'map as tuple' and accessed using the
  364. following procedures:  
  365.     subprog_patch_get(symbol)
  366.     subprog_patch_put(symbol,offset)
  367.     subprog_patch_undef(symbol)
  368. SUBPROG_PATCH is similar to CODE_PATCH_SET and DATA_PATCH_SET as
  369. described below, except that it is a map from procedure names (symbols)
  370. to offsets.  It is iterated over and values in the domain are unefined
  371. (SUBPROG_PATCH(sym) := OM).  Note that it is dead after the (single)
  372. iteration over it (about lines 10247/10315 in SETL source.  For now, we
  373. will kept SUBPROG_PATCH as a 'map as tuple', i.e., a tuple in which
  374. successive pairs of elements give the domain and range values.  
  375.  
  376. In SETL, CODE_PATCH_SET and DATA_PATCH_SET are sets of offsets.  In the
  377. C version we keep them as tuples (of unsigned integers giving offsets).
  378. The references to them are relatively few.  We will maintain tradition
  379. and check for duplicates before insertion, although there is a single
  380. iteration over them, and this check could be deferrred until that point,
  381. doing a to sort then and eliminating duplicates.  
  382.  */
  383.  
  384. /*            Type Templates */
  385.  
  386.  
  387. /*            Associated symbols
  388.  
  389. Several symbols have associated with them other symbols. This is done
  390. in SETL version by adding a special suffix to the unique name. Of
  391. course this is a no-no in C. In C there is a (new) symbol table field
  392. associated_symbols, whose value is a tuple of symbols. They are needed
  393. as follows:
  394.  
  395. For a subprogram
  396.     (1)    proc_template: the template for the procedure
  397.     (2)    return_template: the template for the returned value 
  398.         (defined only for functions).
  399. For a package:
  400.     (1)    init_spec: procedure to initialize package specification
  401.     (2)    init_body: procedure corresponding to package body
  402.     (3)    init_tasks: procedure to activate tasks declared
  403.         in package.
  404. For a task:
  405.     (1)    task_init_proc: procedure to elaborate task
  406. NOTE: In original change to SETL version to introduce these (edits
  407. done 3-35-85, what is here called 'task_init_proc' was called 'init_proc'
  408. in SETL version. We changed name to avoid conflict with 'init_proc' map in
  409. SETL version.
  410. For a formal parameter:
  411.     (1)    formal_template: template for formal parameter
  412.     (2)    actual_template: template for actual, reused
  413.         at each call
  414. The above fields are accessed using the following procedures:
  415.     Symbol assoc_symbol_get(sym,fldname)
  416.     assoc_symbol_put(sym,fldname,sval)
  417. where sym and sval are symbols, and fldname gives the offset of the field within
  418. the tuple of associated_symbols:
  419. */
  420. #define TASK_INIT_PROC    1
  421. #define PROC_TEMPLATE    1
  422. #define RETURN_TEMPLATE    2
  423. #define FORMAL_TEMPLATE    1
  424. #define ACTUAL_TEMPLATE    2
  425. #define INIT_SPEC    1
  426. #define INIT_BODY    2
  427. #define INIT_TASKS    3
  428. /*
  429. TBSL: save and restore the associated names in the binder, as well
  430. as everything else!
  431.  */
  432.  
  433. /* 
  434.  
  435. Calls to COMPILER_ERROR in SETL are translated to calls to
  436. commpiler_error in C.  Where the SETL version builds up a string the C
  437. version adds a suffix to indicate argument type.  For example
  438. compiler_error_n(s,n) to pass node.  The case compiler_error_k is used
  439. to pass node for which the SETL version has 
  440.      COMPILER_ERROR(s  + str N_KIND(node)
  441. This is written in C as
  442.     compiler_error_k(s, node)
  443.  */
  444. #ifdef EXPORT
  445. #define compiler_error(r)       exit_internal_error()
  446. #define compiler_error_k(r,n)       exit_internal_error()
  447. #define compiler_error_c(r,c)      exit_internal_error()
  448. #define compiler_error_s(r,s)      exit_internal_error()
  449. #endif
  450.  
  451. /* macros for GEN from preface */
  452. #define COMPONENT_TYPE(type_name) component_type(type_name)
  453.  
  454. #define DEFAULT_EXPR(obj_name) default_expr(obj_name)
  455.  
  456. #define DESIGNATED_TYPE(acc_typ) designated_type(acc_typ)
  457.  
  458. /*
  459. macro DISCRIMINANT_LIST(record); SIGNATURE(root_type(record))(2)   endm;
  460. This is procedure in C version.
  461.  */
  462.  
  463. #define FIELD_NUMBER(x)           MISC(x)
  464.  
  465. #define FIELD_OFFSET(x)      S_OFFSET(x)
  466.  
  467. /*
  468. macro FIND;                     assert exists                     endm;
  469.  */
  470.  
  471. /*
  472.  * GET_TYPE is procedure get_type() in C:
  473.  *     macro GET_TYPE(node);
  474.  *  (if N_KIND(node) in [as_simple_name, as_subtype_indic]
  475.  *                        then TYPE_OF(N_UNQ(node))
  476.  *                        }
  477.  *                        else N_TYPE(node) end )                   endm;
  478.  */
  479.  
  480. /*
  481.  *    GET_CONSTRAINT is procedure get_constraint() in C:
  482.  *    macro GET_CONSTRAINT(type_name);
  483.  *              (if is_access_type(type_name) then [co_access]
  484.  *               }
  485.  *               elseif is_array_type(type_name)    then [co_index]
  486.  *        else SIGNATURE(type_name) end )                    endm;
  487.  */
  488.  
  489. /*
  490.  *   macro GLOBAL_REFERENCE(name,ref);(REFERENCE_MAP(name) = ref)      endm;
  491.  *  This macro is never used, so its translation is immaterial!
  492.  *
  493.  *
  494.  *
  495.  *
  496.  */
  497. #define INDEX_TYPES(type_name) index_types(type_name)
  498.  
  499. #define INVARIANT_PART(record) invariant_part(record)
  500.  
  501. /*
  502. macro MU_SIZE(mu_nam);           MEM_LOC_MAP(mu_nam)(TARGET)       endm;
  503.  * is procedure in C
  504.  */
  505.  
  506.  
  507. /* NEW_UNIQUE_NAME is procedure new_unique_name() in C:
  508.  *  macro NEW_UNIQUE_NAME(name);     (name + str(newat))               endm;
  509.  */
  510.  
  511. #ifdef TBSN
  512. macro NEXT_NODE;                 (NODE_COUNT += 1)                endm;
  513. #endif
  514.  
  515. /*
  516.  *  macro NO(arg);                   ((arg)=om)                        endm;
  517.  */
  518.  
  519. /*
  520.    macro PC;                        (#CODE_SEGMENT+1)                 endm;
  521.   done as procedure PC() in C version.
  522.  */
  523.  
  524. /*
  525.  * macro PRESENT(x);                ((x)/=om)                         endm;
  526.  */
  527.  
  528. #define ROOT_TYPE(typ) root_type(typ)
  529.  
  530.  
  531. /*
  532.  * macro SIZE_OF(typ);              TYPE_SIZE(typ)(TARGET)            endm;
  533.  *
  534.  * In C, SIZE_OF corresponds to TYPE_SIZE. Since the SETL version always
  535.  * uses 'size_of' not 'SIZE_OF' we define the macro in lower case
  536.  */
  537. #define size_of(typ) TYPE_SIZE(typ)
  538.  
  539. /* SMALL_OF is procedure small_of() in C:
  540.  *   macro SMALL_OF(typ); GET_IVALUE(SIGNATURE(typ)(5))     endm;
  541.  */
  542.  
  543. /*
  544.  * macro TOP(x);                    x(#x)                             endm;
  545.  */
  546.  
  547. /*
  548.  * macro USER_WARNING(line);
  549.  *   PRINTA(GENfile,ERR_WARNING,ada_line,0,ada_line,0,'    '+line)    endm;
  550.  * in SETL, USER_WARNING is often called with long strings, so in C
  551.  * we permit two arguments, which are concatenated when message written
  552.  */
  553. #define USER_WARNING(s1,s2) user_warning(s1,s2)
  554.  
  555. /* USER_INFO is called only two or three times, in each case withi
  556.  * the argument being 'formatted_name...'
  557.  * macro USER_INFO(line);
  558.  *    PRINTA(GENfile,INFORMATION,ada_line,0,ada_line,0,'    '+line)    endm;
  559.  * This is done by procedure user_info in gmisc.c.
  560.  */
  561. #define USER_INFO(line) user_info(line)
  562.  
  563. /* In the C version, the TO_GEN macro corresponds to the procedures 
  564.  * whose names begin with to_gen in file gmisc.c 
  565.  *  macro TO_GEN(line);
  566.  *   PRINTA(GENfile,INFORMATION,ada_line,0,ada_line,0,'    '+line)    endm;
  567.  * Similarly TO_LIST corresponds to procedure to_list().
  568.  * macro TO_LIST(line);
  569.  *    PRINTA(GENfile,INFORMATION,9999,0,9999,0,'    '+line)            endm;
  570.  */
  571.  
  572. /* IN SETL TO_ERR is always called with string followed by filename 
  573.  * In C, call to_err with two arguments and let to_err() in gmisc.c sort
  574.  * things out
  575.  *   macro TO_ERR(line);
  576.  *    PRINTA(GENfile,ERR_SEMANTIC,ada_line,0,ada_line,0,'    '+line)    endm;
  577.  */
  578. #define TO_ERR(line,filename) to_err(line,filename)
  579.  
  580. /* In C, BIND_ERR corresponds to procedure bind_err 
  581.  *macro BIND_ERR(line);
  582.  *    ERROR_IN_UNIT = true;
  583.  *   PRINTA(GENfile,ERR_BIND,ada_line,0,ada_line,0,'    '+line)    endm;
  584.  */
  585.  
  586. /* Macro defined but never used in code generator
  587.  * macro MISC_TYPE_ATTRIBUTES(typ); OVERLOADS(typ)                    endm;
  588.  */
  589.  
  590. /* NATURE_ROOT_TYPE is procedure nature_root_type() in C:
  591.  *    NATURE_ROOT_TYPE(typ)     NATURE(root_type(typ))
  592.  */
  593.  
  594. /* PRIVATE_DECLS is not defined here as a macro for C version.
  595.  * Needed definition in sem hdr.c
  596.  *   macro PRIVATE_DECLS(package);    OVERLOADS(package)                endm;
  597.  */
  598.  
  599. /* VARIANT_PART defined but not used in code generator
  600.  * macro VARIANT_PART(record);      SIGNATURE(record)(1)(2)           endm;
  601.  */
  602.  
  603. /*S+ Is... and other predicate macros */
  604.  
  605. /* HAS_DISCRIMINANT is procedure has_discriminant() in C:
  606.  *    HAS_DISCRIMINANT(typ);   (discriminant_list(typ) ? [] /= []) endm;
  607.  */
  608.  
  609. /* HAS_SIDE_EFFECT defined but never used
  610.  * macro HAS_SIDE_EFFECT(node);    N_SIDE(node)                       endm;
  611.  */
  612.  
  613. /* HAS_STATIC_SIZE is procedure has_static_size() in C:
  614.  *    HAS_STATIC_SIZE(typ);    (size_of(typ) >= 0)                 endm;
  615.  */
  616.  
  617. /* IS_AGGREGATE is procedure is_aggregate() in C:
  618.     macro IS_AGGREGATE(node);   (N_KIND(node) in
  619.                      [as_array_aggregate,  as_array_ivalue,
  620.                       as_record_aggregate, as_record_ivalue])      endm;
  621.  */
  622.  
  623. /*
  624.  * macro IS_ANCESTOR(na); (na(2..) = UNIT_NAME(#UNIT_NAME-#na+2..))   endm;
  625.  * is procedure is_ancestor() in C.
  626.  */
  627. #define IS_ANCESTOR(na) is_ancestor()
  628.  
  629.  
  630. /* IS_FORMAL_PARAMETER is procedure is_formal_parameter() in C:
  631.  *   IS_FORMAL_PARAMETER(na);NATURE(na) in [na_in,na_inout,na_out]endm;
  632.  *
  633.  
  634.  * IS_GLOBAL is procedure is_global in C 
  635.  *    IS_GLOBAL(na);            present(REFERENCE_MAP(na))         endm;
  636.  * In SETL this is defined as IS_GLOBAL but then referenced using
  637.  * is_global.
  638.  *
  639.  */
  640.  
  641. /* 
  642.  * macro IS_GENERIC(na);       (na(2) in domain late_instances)       endm;
  643.  * is procedure is_generic_gen() in C
  644.  * use is_generic_gen since is_generic is macro in hdr.c (sem)
  645.  */
  646. #define IS_GENERIC(na) is_generic_gen(na)
  647.  
  648.  
  649. /* IS_IVALUE is procedure is_ivalue() in C;
  650.  *   macro IS_IVALUE(node);      (N_KIND(node) in
  651.  *     [as_ivalue, as_int_literal, as_string_ivalue, as_real_literal,
  652.  *      as_array_ivalue, as_record_ivalue])                             endm;
  653.  *
  654.  *   macro IS_OBJECT(node);      (N_KIND(node) in
  655.  *  [as_simple_name,as_null,as_name,as_slice,as_index,as_selector]) endm;
  656.  * This is procedure in C.
  657.  *
  658.  * IS_RENAMING is procedure is_renaming() in C;
  659.  *   macro IS_RENAMING(na);          present(ALIAS(na))                 endm;
  660.  *
  661.  *
  662.  *   macro IS_SIMPLE_NAME(node);
  663.  *       (N_KIND(node) in [as_simple_name,as_null,as_name])         endm;
  664.  * is procedure in C.
  665.  *
  666.  * In C, IS_SUBUNIT is procedure is_subunit():
  667.  *    IS_SUBUNIT(na);           (#na > 2)                          endm;
  668.  *
  669.  * IS_ACCESS_TYPE is procedure is_access_type() in C:
  670.  *   IS_ACCESS_TYPE(typ)     (nature_root_type(typ) == na_access)
  671.  *
  672.  * IS_ARRAY_TYPE is procedure is_array_type() in C;
  673.  *   IS_ARRAY_TYPE(typ)      (nature_root_type(typ) == na_array)
  674.  *
  675.  *
  676.  * IS_ENTRY_TYPE is procedure is_entry_type() in C:
  677.  *   IS_ENTRY_TYPE(typ)      (nature(typ)==na_entry_former)
  678.  */
  679.  
  680. #define IS_ENUMERATION_TYPE(typ) (nature_root_type(typ) == na_enum)
  681.  
  682. /* IS_FIXED_TYPE is procedure is_fixed_type() in C:
  683.  *   macro IS_FIXED_TYPE(typ);      (SIGNATURE(typ)(1) = co_delta)      endm;
  684.  *
  685.  * IS_FLOAT_TYPE is procedure is_float_type() in C:
  686.  *    IS_FLOAT_TYPE(typ);     (SIGNATURE(typ)(1) = co_digits)     
  687.  *
  688.  * IS_INTEGER_TYPE is procedure is_integer_type() in C:
  689.  *   IS_INTEGER_TYPE(typ)    (root_type(typ) == symbol_integer) 
  690.  *
  691.  * IS_RECORD_TYPE is procedure is_record_type() in C:
  692.  *   define IS_RECORD_TYPE(typ)     (nature_root_type(typ) == na_record)
  693.  *
  694.  * IS_RECORD_SUBTYPE is procedure is_record_subtype() in C:
  695.  *   #IS_RECORD_SUBTYPE(typ) 
  696.  *               (is_record_type(typ) && NATURE(typ)==na_subtype)
  697.  *
  698.  * IS_SIMPLE_TYPE is procedure is_simple_type() in C:
  699.  *  
  700.  * (nature_root_type(typ) != na_array && 
  701.  *               nature_root_type(typ) != na_record)
  702.  *
  703.  * IS_STRUCTURED_TYPE is procedure is_structured_type() in C:
  704.  *   IS_STRUCTURED_TYPE(typ) 
  705.  *    (nature_root_type(typ) == na_array || nature_root_type(typ) == na_record)
  706.  *
  707.  * IS_STATIC_TYPE is procedure is_static_type() in C:
  708.  *   macro IS_STATIC_TYPE(typ);
  709.  *                        (is_global(typ) and has_static_size(typ)) endm;
  710.  *
  711.  * IS_TASK_TYPE is procedure is_task_type() in C:
  712.  *   IS_TASK_TYPE(typ);
  713.  *                 (   (nature_root_type(typ) = na_task_type)
  714.  *                  or (nature_root_type(typ) = na_task_type_spec)) endm;
  715.  *
  716.  * 
  717.  *    CONTAINS_TASK(typ)      MISC(typ)
  718.  */
  719. #define CONTAINS_TASK(typ)     MISC(typ)
  720.  
  721. /*S+Macros for operations on real numbers */
  722. /* For C, F_TO_I and I_TO_F are no-ops. These are needed in SETL
  723.  * for repr's.
  724.  */
  725. #define F_TO_I(x) x
  726. #define I_TO_F(x) x
  727.  
  728. /*S+Macros for operations on rational numbers */
  729.  
  730. /* performs rounded division of u by v 
  731.  * macro ROUND_DIV(u,v); ((2*u+sign(u)*v) div (2*v)) endm;
  732.  * This is done by procedure round_div in C version.
  733.  */
  734.  
  735. /* numerator and denominator
  736.  * SETL macros NUM and DEN correspond to macros num and den defined
  737.  * in arith.h.
  738.  */
  739.  
  740. /*  Absolute value of rational number 
  741.  *
  742.  *    macro RAT_ABS (u);    [abs (num(u)), den(u)]  endm;
  743.  * This corresponds to procedure rat_abs() in arith.c in C version.
  744.  */
  745.  
  746. /*
  747.  *    macro RAT_ADD (u, v);
  748.  *        [num(u)*den(v) + num(v)*den(u), den(u)*den(v)]             endm;
  749.  * This is procedure rat_add() in arith.c in C version.
  750.  */
  751.  
  752.  
  753. /*
  754. macro RAT_DIV (u, v);
  755.          [num(u)*den(v), num(v)*den(u)]                            endm;
  756. * This is procedure rat_div() in arith.c in C  version.
  757. */
  758.  
  759.  
  760. /* Test rational numbers for equality 
  761.  *
  762.     macro RAT_EQL (u, v);  (num(u)*den(v) = num(v)*den(u))             endm;
  763.  * This is not used in SETL source.
  764.  */
  765. /* RAT_LT is procedure rat_lss() in C:
  766.  *     RAT_LT (u, v);
  767.  *       (num(u)*den(v) < num(v)*den(u))                            endm;
  768.  */
  769. #define rat_lt(a,b) rat_lss(a,b)
  770.  
  771. /* In C, RAT_GTR is defined in arith.c 
  772.  *  macro RAT_GTR (u, v);
  773.  *       (num(u)*den(v) > num(v)*den(u))                            endm;
  774.  */
  775.  
  776.  
  777. /* In C, rat_toi is defined in arith.c
  778.  *  macro RAT_TOI(u);
  779.  *           round_div(num(u),den(u))                           endm;
  780.  */
  781.  
  782. /*
  783.  *  Convert the rational number u to a SETL integer.  The number
  784.  *  u is rounded.
  785.  */
  786.  
  787. /*S+ macros for operations on booleans 
  788.  *    macro ada_bool(X);    transform a SETL boolean into 0 or 1 
  789.  *  (if X then 1 else 0 end) endm
  790.  * This is procedure ada_bool() in C version.
  791.  */
  792.  
  793. /*S+ macros to pack/unpack information from symbol tables */
  794. #ifdef TBSN
  795. macro AIS_INFO(name);
  796.    [COMP_DATE(name) ,PRE_COMP(name), UNIT_DECL(name), CODE_UNITS(name)]
  797. endm;
  798. #endif
  799.  
  800. /*
  801. macro SYMBTABF(unam);
  802.    [NATURE   (unam), TYPE_OF(unam), SIGNATURE(unam), OVERLOADS(unam),
  803.     SCOPE_OF (unam), ALIAS  (unam)
  804.    ]
  805. endm;
  806.  */
  807.  
  808. /*
  809. macro SYMBTABFQ(unam);
  810.    [NATURE   (unam), TYPE_OF(unam), SIGNATURE(unam), OVERLOADS(unam),
  811.     SCOPE_OF (unam), ALIAS  (unam),
  812.     TYPE_SIZE(unam), REFERENCE_MAP(unam), MISC(unam),INIT_PROC(unam)
  813.    ]
  814. endm;
  815. */
  816.  
  817. /* ops.h defines symbols starting with i_ that are used for 
  818.  * ada machine opcodes. This file is included explicitly by those
  819.  * files that need it.
  820.  */ 
  821.  
  822.  
  823. /*S+ Global constants */
  824. #define   SETL                           1
  825. #define   VAXC                           2
  826. #define   IBMPC                          3
  827.  
  828. /* error types for makelist listing processor */
  829. /* make ERR_COMPILER macro if needed; needed ERR_ codes defined in config.h */
  830. /*ERR_COMPILER                   16 */
  831.  
  832. #define   IBMPC_MAX_INTEGER              +32767
  833. #define   IBMPC_MIN_INTEGER              -32768
  834. #define   IBMPC_MAX_SHORT                +127
  835. #define   IBMPC_MIN_SHORT                -128
  836. #ifdef TBSN
  837. -- these are defined by SEM
  838. #define   ADA_MIN_REAL                   -1.0E30
  839. #define   ADA_MAX_REAL                   +1.0E30
  840. #define   ADA_REAL_DIGITS                 6
  841. #endif
  842.  
  843. /*S+ Nature definitions */
  844.  
  845. /* -- na_ codes defined in hdr.h  */
  846.  
  847.  
  848. /*S+ Constraints definitions */
  849. /* These are currently handled differently in sem and gen; perhaps
  850.  * the following codes used in gen phase should be used in sem as well:
  851.  * These are defined as strings in SETL, make integers in C.
  852.  * Codes _range, _digits, _delta _discr and _array defined by adasem.
  853.  * codes _index and _access defined by adagen
  854.  */
  855. #define co_range 0
  856. #define co_digits 1
  857. #define co_delta 2
  858. #define co_discr 3
  859. #define co_array 4
  860. #define co_index 5
  861. #define co_access 6
  862.  
  863. /*S+ Memory units definitions */
  864. /* These are defined as strings in SETL, can be integers in C. */
  865. #define   mu_byte             1
  866. #define   mu_word             2
  867. #define   mu_addr             3
  868. #define   mu_long             4
  869. #define   mu_dble             5
  870. #define   mu_xlng             6
  871. /* mu_fixed1 and mu_fixed2 are codes for short and long fixed, resp.*/
  872. /* They were added to C version since SETL code in type.c used
  873.  * explicit values
  874.  *    ds    21-mar-85
  875.  */
  876. #define   mu_fixed1            mu_word  /* check this */
  877. #define   mu_fixed2            mu_dble     /* review this too */
  878.  
  879. /*S+ Nodes definition */
  880. /* These are constants in SETL, should be variables in C 
  881.  
  882.    OPT_NAME                      = '',
  883.    OPT_NODE                  = 0,
  884.    ANY_NODE                     = 1,
  885.  */
  886.  
  887. /* The following codes define node kinds. Copy code from sem hdr file
  888.  * and verify that no new natures introduced.
  889.  */
  890.  
  891. /*
  892. -- as_ codes defined in hdr.c
  893.  */
  894.  
  895. /*S+ Machine instructions */
  896. /* these are defined in hdr.c */
  897.  
  898. /*S+ Definition of attributes */
  899. /* TBSL: The SETL code uses the folowing attribute codes - they should 
  900. be
  901.  * converted to those used by adasem:
  902.  */
  903.  
  904. /* a_... attributes codes defined in hdr.c */
  905.  
  906.  
  907. /*            Type Templates
  908.  
  909. A type template is a record used for the run-time elaboration of types.
  910. In SETL, it is represented as a tuple; however, such a tuple is
  911. typically a 'ragged array' in that the elements reflect different value
  912. types and lengths so that the translation to C is not obvious.  Template
  913. handling is largely confined to initialization (init.c), and the type
  914. generation procedures (type.c).  Templates are only generated, never
  915. used.  The generator does not look at templates once generated.  
  916. In C, templates are represented as data segments; however, they are
  917. allocated by the procedure template_new(kind, sizeof) which sets the
  918. allocation expansion factor and the values of the first two entries.
  919.  
  920. There are 17 different kinds of templates. The first entry of each is
  921. the template type code, one of TT_I_RANGE .. TT_SUBPROG. The second
  922. entry gives the object size (TT_OBJECT_SIZE), typically one. The
  923. remaining entries depend on the template type code. 
  924.  
  925. It appears to be the case that templates are generated and then
  926. passed to the procedure install_type() that copies their values to
  927. the appropriate generated segment, after which the template value is
  928. dead, so that install_type() could free the space allocated to the
  929. template. This should be confirmed.
  930.  
  931. */
  932. /*
  933.  *S+ constants for type template access
  934.  *  type templates are internally generated objects used to represent
  935.  *  ada types at run-time.
  936.  *  For the intial version, we define variant template types where
  937.  *  the SETL version has a single template type but with differing
  938.  *  object sizes, for example,the SETL TT_I_RANGE becomes TT_I_RANGE_I
  939.  *  and TT_I_RANGE_L (for integer and long integer respectively).
  940.  *
  941.  *S+ type templates
  942.  */
  943.  
  944. /* Note that TT_I_RANGE assumed to be two byte int for now ds 6-6-85*/
  945. /* The structures and macros used for template accessed are defined
  946.  * in the header file type.h
  947.  */
  948.  
  949. /*S+Miscelleanous */
  950. /* for fixed_point representation */
  951. #define  WORD_SIZE  32    
  952.  
  953. /* number of elements in the SFP */
  954. #define  SFP_SIZE   4
  955.  
  956. /* for pretty-print */
  957. #define  max_width  80
  958.  
  959. /* The SETL map EMAP is accessed in C by the following procedures:
  960.      emap_get(symbol)
  961.     emap_put(symbol,value)
  962.   Note that emap_get returns TRUE if EMAP defined for the argument,
  963.   and sets EMAP_VALUE to the value, or returns FALSE if the value
  964.   not defined.
  965.   The SETL sequence
  966.     EMAP(s) = OM;
  967.   is translated as
  968.     emap_undef(s);
  969.  */
  970.  
  971. /* The SETL maps STATIC_DEPTH, POSITION, PATCHES and EQUAL are
  972.  * handled by procedure calls in the C version,
  973.  *
  974.  *
  975.  *    STATIC_DEPTH,    map { label_name -> positive_integer } 
  976.  *   POSITION,        map { label_name -> code location } 
  977.  *   PATCHES,         map { label_name -> {set of locations} } 
  978.  *   EQUAL,           map { label_name -> {set of label names} } 
  979.  *
  980.  *  Suggest representing these using EMAP 
  981.  * We represent these using EMAP as a tuple: 1-STATIC_DEPTH,
  982.  * 2-POSITION, 3-PATCHES, 4-EQUAL.
  983.  */
  984. #define LABEL_SIZE 4
  985. #define LABEL_STATIC_DEPTH 1
  986. #define LABEL_POSITION 2
  987. #define LABEL_PATCHES 3
  988. #define LABEL_EQUAL 4
  989.  
  990. /* The following structure is used to save global variable definitions
  991.  * for use by print_global_reference_map.
  992.  */
  993.  
  994. typedef struct Gref_s {
  995.     Symbol gref_sym; /* symbol */
  996.     short  gref_seg; /* segment */
  997.     int    gref_off; /* offset */
  998.     } Gref_s;
  999. typedef struct Gref_s *Gref;
  1000.